COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "ENTROP"
C00006 ENDMK
C⊗;
BEGIN "ENTROP"
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
INTEGER I,J,K,L,C,D,PICLNBY; REAL INF,INP,PA,PB;
STRING BF; INTEGER SAFE ARRAY PIC[0:10];
DEFINE L2LEN=5000;
REAL SAFE ARRAY L2[0:L2LEN];
INTEGER CONTEX,CONTEX2;
FOR I←0 STEP 1 UNTIL L2LEN DO L2[I]←-LOG((I/L2LEN) MAX 0.00001)/LOG(2);
DO PRINT("BIT FILE:") UNTIL PFLDIM(BF←INCHWL)>0;
WHILE TRUE DO
   BEGIN
   INTEGER CH; STRING S;
   PRINT("Window size:"); CONTEX←CVD(INCHWL); CONTEX2←CONTEX*CONTEX;
   PRINT("Gain rate (ε):"); PA←REALSCAN(S←INCHWL,I); PB←1-PA;
   CH←OPNPFL(BF,PIC[0]);
   PICLNBY←PIC[LNBY];
      BEGIN
      REAL SAFE ARRAY PRED[0:1 ASH (CONTEX2-1)-1];

      ARRCLR(PRED,0.5);
	 BEGIN
	 INTEGER SAFE ARRAY BPS[0:CONTEX-1,0:CONTEX-1],BPT[0:CONTEX2-1];
	 INTEGER SAFE ARRAY BITS[0:CONTEX-1,-1:PIC[LNWD]-1];
	  
	 FOR I←0 STEP 1 UNTIL CONTEX-1 DO
	 FOR J←0 STEP 1 UNTIL CONTEX-1 DO
	    BPS[I,J]←POINT(1,BITS[I,-1],36-CONTEX+J);

	 INF←0; INP←0;
	 FOR L←0 STEP 1 UNTIL PIC[PCLN]-1 DO
	    BEGIN
	    ARRYIN(CH,BITS[L MOD CONTEX,0],PIC[LNWD]);

            FOR I←0 STEP 1 UNTIL CONTEX-2 DO
            FOR J←0 STEP 1 UNTIL CONTEX-1 DO
               BPS[I,J]↔BPS[I+1,J];

	    ARRBLT(BPT[0],BPS[0,0],CONTEX2);
	    FOR J←0 STEP 1 UNTIL PICLNBY-1 DO
	       BEGIN
 	       C←ILDB(BPT[0]);
	       FOR K←1 STEP 1 UNTIL CONTEX2-2 DO C←(C ASH 1) LOR ILDB(BPT[K]);
	       IF ILDB(BPT[CONTEX2-1]) THEN
                  BEGIN
                  INF←INF + L2[L2LEN*PRED[C]];
                  PRED[C]←(PRED[C]*PB+PA) MIN .99999;
                  END
               ELSE
                  BEGIN
                  INF←INF + L2[L2LEN*(1-PRED[C])];
                  PRED[C]←(PRED[C]*PB) MAX .00001;
                  END;
	       END;
            INP←INP+PICLNBY;
            IF (L LAND 63)=0 THEN
	    PRINT(INP," bits ",INF," crunched ",INP/INF," GAIN ",'15&'12);
	    END;
         PRINT(INP," bits ",INF," crunched ",INP/INF," GAIN ",'15&'12);
	 END;
      RELEASE(CH);
      END;
   END;

END "ENTROP";